home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Magnum One
/
Magnum One (Mid-American Digital) (Disc Manufacturing).iso
/
d18
/
opbonus.arc
/
WFIELD.ARC
/
WFIELD4.PAS
< prev
Wrap
Pascal/Delphi Source File
|
1991-03-20
|
19KB
|
668 lines
{$V-}
(*
WFIELD4
-------
This program demonstrates several neat tricks made possible by the features
added in Object Professional 1.01:
- a menu embedded within another object derived from a command window
- a scrolling entry screen embedded within a regular entry screen
- storing a parent window and all its children within a stream
- reloading a parent window and its children from a stream
Points worth noting:
1) Defining TestStream (by removing the '.' before the '$') causes the
program to be compiled in such a way that the entry screen and all its
children are instantiated, stored in the stream, then reinstantiated by
rereading them from the stream. Note, however, that SES and MM are no
longer valid objects once ES has been reread from the stream. Child
windows are always allocated dynamically on the heap when they are read
back from the stream. That's why the pointer variable 'MP^' is used to
refer to the menu, rather than 'MM'.
2) The scrolling entry screen (the child) is attached to the main entry
screen (the parent) using AddWindowField. The menu is not a field,
however, so it must be attached using the AddChild method.
3) The menu can be activated/deactivated by pressing <F10>. In this
do-nothing demo, selecting any menu item button outside the menu simply
returns you to where you were before the menu was activated. Clicking
the left mouse button outside the menu also returns you to where you
were before, unless the mouse was clicked on a particular field. Notice
that EraseAllSubMenus must be called when the menu is deactivated to
insure that the submenus don't get overwritten by one of the fields in
the parent entry screen.
4) From within the main entry screen, the mouse can be used to select
the child window, the menu, the "exit" hot spot, as well as any field
in the entry screen. Note, however, that when you "jump" into the child
entry screen, the cursor moves to the field in the entry screen that was
current the last time you left.
5) Notice that the InvokeMenu routine calls EntryScreen.EvaluateCommand,
which according to the manual is supposed to be called only from within
a post-edit routine. In general, the manual is correct on that point,
but in the case of ccMouseSel it is safe to evaluate the command outside
of a post-edit routine.
6) The scrolling entry screen is both a field in the main entry screen and
an entry screen in its own right. You can move in and out of the main
entry screen using the basic field movement commands (<Enter>, <Tab>,
<ShTab>, <Up>, <Down>), but once you are in the child entry screen the
other field movement commands (<PgUp>, <PgDn>, <CtrlPgUp>, <CtrlPgDn>)
are restricted to moving the cursor around the child window.
7) In the scrolling entry screen, the Total field on each row is a
protected field whose value is calculated dynamically by the post-edit
routine.
8) The wNoCoversBuffer option is used for the ScrollingEntryScreen field
to limit memory usage.
*)
{.$DEFINE TestStream}
program WFIELD4;
{$I OPDEFINE.INC}
uses
Dos,
OpInline,
OpString,
OpRoot,
OpCrt,
{$IFDEF UseMouse}
OpMouse,
{$ENDIF}
OpAbsFld,
OpCmd,
OpField,
OpFrame,
OpWindow,
OpSelect,
OpEntry,
OpMenu;
{$IFDEF UseMouse}
const
MouseChar : Char = #04;
{$ENDIF}
{Color set used by entry screen}
const
EsColors : ColorSet = (
TextColor : $1A; TextMono : $0F;
CtrlColor : $1E; CtrlMono : $08;
FrameColor : $1A; FrameMono : $0F;
HeaderColor : $1F; HeaderMono : $70;
ShadowColor : $08; ShadowMono : $0F;
HighlightColor : $4F; HighlightMono : $70;
PromptColor : $1F; PromptMono : $0F;
SelPromptColor : $1F; SelPromptMono : $0F;
ProPromptColor : $17; ProPromptMono : $07;
FieldColor : $1A; FieldMono : $07;
SelFieldColor : $2F; SelFieldMono : $70;
ProFieldColor : $1B; ProFieldMono : $07;
ScrollBarColor : $13; ScrollBarMono : $07;
SliderColor : $13; SliderMono : $0F;
HotSpotColor : $30; HotSpotMono : $70;
BlockColor : $3E; BlockMono : $0F;
MarkerColor : $3F; MarkerMono : $70;
DelimColor : $1E; DelimMono : $0F;
SelDelimColor : $31; SelDelimMono : $0F;
ProDelimColor : $1E; ProDelimMono : $0F;
SelItemColor : $2F; SelItemMono : $70;
ProItemColor : $17; ProItemMono : $07;
HighItemColor : $1F; HighItemMono : $0F;
AltItemColor : $1F; AltItemMono : $0F;
AltSelItemColor : $2F; AltSelItemMono : $70;
FlexAHelpColor : $1F; FlexAHelpMono : $0F;
FlexBHelpColor : $1F; FlexBHelpMono : $0F;
FlexCHelpColor : $1B; FlexCHelpMono : $70;
UnselXrefColor : $1E; UnselXrefMono : $09;
SelXrefColor : $5F; SelXrefMono : $70;
MouseColor : $4F; MouseMono : $70);
{Entry field constants}
const
idAcctNo = 0;
idName = 1;
idCompany = 2;
idAddress = 3;
idCity = 4;
idState = 5;
idZipCode = 6;
idPhone = 7;
idEntries = 8;
{these ID's are relative to the ID for the first field on a given row--see
PostEdit, below}
idQuantity = 0;
idCost = 1;
idDescription = 2;
idTotal = 3;
{Child window indexes}
cwMenu = 1;
cwSEntry = 2;
{Menu item constants}
const
miCalculate1 = 1;
miGross2 = 2;
miNet3 = 3;
miSearch4 = 4;
miAcct5 = 5;
miName6 = 6;
miCompany7 = 7;
miAddress8 = 8;
miCity9 = 9;
miState10 = 10;
miZip11 = 11;
miPhone12 = 12;
miHelp13 = 13;
miQuit14 = 14;
const
MaxEntries = 50;
type
UserRecord =
record
AcctNo : string[13];
Name : string[30];
Company : string[35];
Address : string[35];
City : string[25];
State : string[15];
ZipCode : string[10];
Phone : string[14];
end;
EntryRec =
record
Quantity : Word;
Cost : Real;
Description : string[20];
Total : Real;
end;
UserEntries = array[1..MaxEntries] of EntryRec;
var
SES : ScrollingEntryScreen;
ES : EntryScreen;
MM : Menu;
MP : ^Menu;
UR : UserRecord;
UE : UserEntries;
I : Word;
Status : Word;
FramePos : FramePosType;
HotCode : Byte;
BarPos : LongInt;
Quit : Boolean;
XAbs : Integer;
YAbs : Integer;
{$IFDEF TestStream}
S : BufIdStream;
{$ENDIF}
function InitMenu(var M : Menu) : Word;
{-Initialize menu system generated by MAKEMENU}
const
Frame1 : FrameArray = '╥╚╥╝─═║║';
WinOptions = wClear+wUserContents+wAllMouseEvents;
begin
with M do begin
if not InitCustom(14, 4, 66, 4, EsColors, WinOptions, Horizontal) then begin
InitMenu := InitStatus;
Exit;
end;
mnOptionsOn(
mnAlphaMatch+mnSelectOnMatch+mnAllowPending+mnArrowSelect+mnAllHotSpots);
mnOptionsOff(
mnPopOnSelect+mnUseItemForTopic+mnMainSelect+mnSelectOnClick);
AddItem(' Calculate ', 2, 2, miCalculate1);
AddFramedSubMenu(16, 6, 22, 7, Vertical, Frame1);
AddItem('Gross', 1, 1, miGross2);
AddItem('Net', 2, 1, miNet3);
ItemsDone;
AddItem(' Search ', 14, 2, miSearch4);
AddFramedSubMenu(28, 6, 37, 13, Vertical, Frame1);
AddItem('Acct #', 1, 1, miAcct5);
AddItem('Name', 2, 1, miName6);
AddItem('Company', 3, 1, miCompany7);
AddItem('Address', 4, 1, miAddress8);
AddItem('City', 5, 1, miCity9);
AddItem('State', 6, 1, miState10);
AddItem('Zip code', 7, 1, miZip11);
AddItem('Phone', 8, 1, miPhone12);
ItemsDone;
AddItem(' Help ', 23, 2, miHelp13);
AddItem(' Quit ', 30, 2, miQuit14);
ItemsDone;
InitMenu := RawError;
end;
end;
{$F+}
procedure PostEdit(ESP : EntryScreenPtr);
{-Called just after a field has been edited}
var
Row : Word;
begin
with ESP^ do
{do nothing if user didn't change the field}
if CurrentFieldModified then begin
{calculate the current row}
Row := Succ(GetCurrentID div 4);
{which column is it?}
case GetCurrentID mod 4 of
{was the cost or quantity changed?}
idQuantity, idCost :
with UE[Row] do begin
{calculate Total for this row}
if (Quantity = 0) or (Cost = BadReal) then
Total := BadReal
else
Total := Quantity*Cost;
{update the Total field for this row}
DrawField((Pred(Row)*4)+idTotal);
end;
end;
end;
end;
{$F-}
function InitScrollingEntryScreen : Word;
{-Initialize the scrolling entry screen}
const
WinOptions = wClear+wUserContents+wAllMouseEvents+wNoCoversBuffer;
var
Row : Word;
begin
with SES do begin
if not InitCustom(14, 16, 66, 21, EsColors, WinOptions) then begin
InitScrollingEntryScreen := InitStatus;
Exit;
end;
{stop at the bottom of the entry screen, but allow exiting at the top}
SetWrapMode(ExitAtTop);
{install post-edit routine to handle the calculated field}
SetPostEditProc(PostEdit);
esFieldOptionsOn(efClearFirstChar);
for Row := 1 to MaxEntries do
with UE[Row] do begin
{idQuantity:}
esFieldOptionsOn(efRightJustify);
esSecFieldOptionsOn(sefSuppressZero);
AddWordField(
LeftPad(Long2Str(Row), 2), Row, 2,
'999', Row, 6,
9, 0, 65535, Quantity);
esFieldOptionsOff(efRightJustify);
esSecFieldOptionsOff(sefSuppressZero);
{idCost:}
esFieldOptionsOn(efRightJustify);
AddRealField(
'', Row, 11,
'$999.99', Row, 11,
10, -1.5E+38, 1.5E+38, 0, Cost);
esFieldOptionsOff(efRightJustify);
{idDescription:}
AddStringField(
'', Row, 20,
'XXXXXXXXXXXXXXXXXXXX', Row, 20, 20,
11, Description);
{idTotal:}
esFieldOptionsOn(efRightJustify+efProtected);
AddRealField(
'', Row, 42,
'$999,999.99', Row, 42,
12, -1.5E+38, 1.5E+38, 0, Total);
esFieldOptionsOff(efRightJustify+efProtected);
end;
{allocate the virtual screen}
AllocateScreen;
InitScrollingEntryScreen := RawError;
end;
end;
function InitEntryScreen : Word;
{-Initialize main entry screen}
const
Frame1 = '┌└┐┘──││';
WinOptions = wBordered+wClear+wUserContents+wAllMouseEvents;
begin
with ES, EsColors do begin
if not InitCustom(14, 6, 66, 21, EsColors, WinOptions) then begin
InitEntryScreen := InitStatus;
Exit;
end;
{make room for the menu up at the top}
with wFrame do
AdjustFrameCoords(frXL, frYL-2, frXH, frYH);
{add the menu as a regular child window, not a field}
AddChild(@MM);
wFrame.SetFrameType(Frame1);
wFrame.AddShadow(shBR, shSeeThru);
wFrame.AddHeader(' Customer Data ', heTC);
{$IFDEF UseHotSpots}
{add a hot spot at the top left corner}
wFrame.AddCustomHeader('[', frTL, 1, 0, FrameColor, FrameMono);
wFrame.AddCustomHeader('■', frTL, 2, 0, FrameColor, FrameMono);
wFrame.AddCustomHeader(']', frTL, 3, 0, FrameColor, FrameMono);
wFrame.AddHotRegion(frTL, hsRegion0, 2, 0, 1, 1); {Close}
{$ENDIF}
{separate the menu from the main entry screen}
wFrame.AddSpanHeader('├', '─', '┤', 02, frTT);
{separate the child entry screen from the parent}
wFrame.AddSpanHeader('├', '─', '┤', 11, frTT);
{label the columns of the scrollable entry screen}
AddTextFieldCustom(
'Qty Cost Description Total', 10, 6,
HeaderColor, HeaderMono);
{don't wrap at edges of the entry screen}
SetWrapMode(StopAtEdges);
esFieldOptionsOn(efClearFirstChar);
{idAcctNo:}
AddStringField(
'Acct #', 1, 4,
'999-99-9999-9', 1, 12, 13,
1, UR.AcctNo);
{idName:}
AddStringField(
'Name', 2, 6,
CharStr('x', 30), 2, 12, 30,
2, UR.Name);
{idCompany:}
AddStringField(
'Company', 3, 3,
CharStr('x', 35), 3, 12, 35,
3, UR.Company);
{idAddress:}
AddStringField(
'Address', 4, 3,
CharStr('x', 35), 4, 12, 35,
4, UR.Address);
{idCity:}
AddStringField(
'City', 5, 6,
CharStr('x', 25), 5, 12, 25,
5, UR.City);
{idState:}
AddStringField(
'State', 6, 5,
'xxxxxxxxxxxxxxx', 6, 12, 15,
6, UR.State);
{idZipCode:}
AddStringField(
'Zip code', 7, 2,
'99999-9999', 7, 12, 10,
7, UR.ZipCode);
{idPhone:}
AddStringField(
'Phone', 8, 5,
'(999) 999-9999', 8, 12, 14,
8, UR.Phone);
{idEntries:}
AddWindowField(
'', 11, 1,
11, 1,
9, SES);
InitEntryScreen := RawError;
end;
end;
procedure InvokeMenu;
{-Invoke the menu}
var
SaveChild : WindowPtr;
ID, Cmd : Word;
begin
{save the active child window}
SaveChild := ES.ActiveChild;
{activate the menu}
ES.SetActiveChild(MP);
{get a choice from the menu, which is now the active child}
ES.Process;
Cmd := ES.GetLastCommand;
case Cmd of
ccSelect :
Quit := (MP^.MenuChoice = miQuit14);
{$IFDEF UseMouse}
ccMouseDown,
ccMouseSel :
begin
{get absolute mouse coordinates}
XAbs := MouseKeyWordX+MouseXLo;
YAbs := MouseKeyWordY+MouseYLo;
{evaluate the position of the mouse when it was clicked}
ES.EvaluatePos(XAbs, YAbs);
BarPos := ES.PosResults(FramePos, HotCode);
{was it clicked on the hot spot?}
if HotCode = hsRegion0 then
Quit := True
else
ES.SetNextField(ES.EvaluateCommand(Cmd));
end;
{$ENDIF}
end;
if not Quit then begin
{erase the menu}
MP^.EraseAllSubMenus(False, True);
{restore the active child}
ES.SetActiveChild(SaveChild);
end;
end;
{$IFDEF TestStream}
procedure RegisterTypes(var S : IdStream);
{-Register data types and pointers}
begin
{register entry screen}
S.RegisterHier(ScrollingEntryScreenStream);
{register field types}
S.RegisterHier(RealFieldStream);
S.RegisterHier(StringFieldStream);
S.RegisterHier(WordFieldStream);
S.RegisterHier(WindowFieldStream);
{register user records}
S.RegisterPointer(1000, @UR);
S.RegisterPointer(1001, @UE);
{register user-written routines}
S.RegisterPointer(1002, @PostEdit);
{register the menu system}
S.RegisterHier(MenuStream);
end;
{$ENDIF}
begin
{initialize user records}
FillChar(UR, SizeOf(UR), 0);
FillChar(UE, SizeOf(UE), 0);
for I := 1 to MaxEntries do
with UE[I] do begin
Cost := BadReal;
Total := BadReal;
end;
{initialize menu}
Status := InitMenu(MM);
if Status <> 0 then begin
WriteLn('MM init error: ', Status);
Halt(1);
end;
{initialize scrolling entry screen}
Status := InitScrollingEntryScreen;
if Status <> 0 then begin
WriteLn('SES init error: ', Status);
Halt(1);
end;
{initialize main entry screen}
Status := InitEntryScreen;
if Status <> 0 then begin
WriteLn('ES init error: ', Status);
Halt(1);
end;
{$IFDEF TestStream}
{set user record for both entry screens}
ES.SetUserRecord(UR, SizeOf(UR));
SES.SetUserRecord(UE, SizeOf(UE));
{create stream file}
S.Init('WFIELD4.STM', SCreate, 4096);
{register types and store the entry screen}
RegisterTypes(S);
S.Put(ES);
Status := S.GetStatus;
if Status <> 0 then begin
WriteLn('Store error: ', Status);
Halt(2);
end;
S.Done;
{dispose of the parent *and* its children}
ES.Done;
{reopen stream file}
S.Init('WFIELD4.STM', SOpen, 4096);
{register types and load the entry screen}
RegisterTypes(S);
S.Get(ES);
Status := S.GetStatus;
if Status <> 0 then begin
WriteLn('Load error: ', Status);
Halt(3);
end;
S.Done;
{get index for child window}
MP := MenuPtr(ES.ChildPtr(cwMenu));
{$ELSE}
MP := @MM;
{$ENDIF}
{clear the screen}
TextChar := #178;
TextAttr := 7;
ClrScr;
{F10 activates menu}
EntryCommands.AddCommand(ccUser0, 1, $4400, 0);
{F10 deactivates menu}
MenuCommands.AddCommand(ccQuit, 1, $4400, 0);
{$IFDEF UseMouse}
if MouseInstalled then
with EsColors do begin
{activate mouse cursor}
SoftMouseCursor($0000, (ColorMono(MouseColor, MouseMono) shl 8)+
Byte(MouseChar));
ShowMouse;
{enable mouse support}
EntryCommands.cpOptionsOn(cpEnableMouse);
MenuCommands.cpOptionsOn(cpEnableMouse);
end;
{$ENDIF}
{test entry screen}
Quit := False;
repeat
ES.Process;
case ES.GetLastCommand of
ccUser0 :
InvokeMenu;
{$IFDEF UseMouse}
ccMouseDown,
ccMouseSel :
begin
{get absolute mouse coordinates}
XAbs := MouseKeyWordX+MouseXLo;
YAbs := MouseKeyWordY+MouseYLo;
{evaluate the position of the mouse when it was clicked}
ES.EvaluatePos(XAbs, YAbs);
BarPos := ES.PosResults(FramePos, HotCode);
{was it clicked on one of the menu choices?}
if (FramePos = frInsideFrame) and MP^.SelectItemByPos(XAbs, YAbs) then
InvokeMenu
else
{was it clicked on the hot spot?}
Quit := (HotCode = hsRegion0);
end;
{$ENDIF}
else Quit := True;
end;
until Quit;
{erase entry screen}
ES.Erase;
{$IFDEF UseMouse}
HideMouse;
{$ENDIF}
{show exit command}
ClrScr;
WriteLn('Exit command = ', ES.GetLastCommand);
{dispose of the parent *and* its children}
ES.Done;
end.